module shr_timer_mod

  !----------------------------------------------------------------------------
  !
  ! routines that support multiple CPU timers via F90 intrinsics
  !
  ! Note:
  ! o if   an operation is requested on an invalid timer number n
  !   then nothing is done in a routine
  ! o if   more than max_timers are requested,
  !   then timer n=max_timers is "overloaded" and becomes invalid/undefined
  !
  ! * cpp if-defs were introduced in 2005 to work-around a bug in the ORNL Cray
  !   X1 F90 intrinsic system_clock() function -- ideally this Cray bug would be
  !   fixed and cpp if-defs would be unnecessary and removed.
  !
  ! !REVISION HISTORY:
  !    2005-??-?? - added workaround for Cray F90 bug, mods by Cray/ORNL
  !    2000-??-?? - 1st version by B. Kauffman
  !----------------------------------------------------------------------------

  use shr_kind_mod
  use shr_log_mod, only: s_loglev  => shr_log_Level
  use shr_log_mod, only: s_logunit => shr_log_Unit

  implicit none

  private  ! restricted access

  public  :: shr_timer_init
  public  :: shr_timer_get
  public  :: shr_timer_start
  public  :: shr_timer_stop
  public  :: shr_timer_print
  public  :: shr_timer_print_all
  public  :: shr_timer_check
  public  :: shr_timer_check_all
  public  :: shr_timer_zero
  public  :: shr_timer_zero_all
  public  :: shr_timer_free
  public  :: shr_timer_free_all
  public  :: shr_timer_sleep

  integer(SHR_KIND_IN),parameter :: stat_free    = 0  ! timer status constants
  integer(SHR_KIND_IN),parameter :: stat_inuse   = 1
  integer(SHR_KIND_IN),parameter :: stat_started = 2
  integer(SHR_KIND_IN),parameter :: stat_stopped = 3
  integer(SHR_KIND_IN),parameter :: max_timers   = 200 ! max number of timers

  integer(SHR_KIND_IN) :: status (max_timers) ! status of each timer
  integer(SHR_KIND_IN) :: cycles1(max_timers) ! cycle number at timer start
  integer(SHR_KIND_IN) :: cycles2(max_timers) ! cycle number at timer stop
  integer(SHR_KIND_IN) :: cycles_max = -1     ! max cycles before wrapping
  character   (len=80) :: name   (max_timers) ! name assigned to each timer
  real   (SHR_KIND_R8) :: dt     (max_timers) ! accumulated time
  integer(SHR_KIND_IN) :: calls  (max_timers) ! # of samples in accumulation
  real   (SHR_KIND_R8) :: clock_rate          ! clock_rate: seconds per cycle

  save

  !===============================================================================
contains
  !===============================================================================

  subroutine shr_timer_init

    !----- local -----
    integer(SHR_KIND_IN) :: cycles ! count rate return by system clock

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_init) ',a,i5)"

    !-------------------------------------------------------------------------------
    ! This routine initializes:
    ! 1) values in all timer array locations
    ! 2) machine parameters necessary for computing cpu time from F90 intrinsics.
    !    F90 intrinsic: system_clock(count_rate=cycles, count_max=cycles_max)
    !-------------------------------------------------------------------------------

    call shr_timer_free_all

    call system_clock(count_rate=cycles, count_max=cycles_max)

    if (cycles /= 0) then
       clock_rate = 1.0_SHR_KIND_R8/real(cycles,SHR_KIND_R8)
    else
       clock_rate = 0._SHR_KIND_R8
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: no system clock available'
    endif

  end subroutine shr_timer_init

  !===============================================================================

  subroutine shr_timer_get(n, str)

    !----- arguments -----
    integer(SHR_KIND_IN),intent(out) :: n    ! timer number
    character (*)       ,intent( in) :: str  ! text string with timer name

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_get) ',a,i5)"

    !-----------------------------------------------------------------------
    !  search for next free timer
    !-----------------------------------------------------------------------

    do n=1,max_timers
       if (status(n) == stat_free) then
          status(n) = stat_inuse
          name  (n) = str
          calls (n) = 0
          return
       endif
    end do

    n=max_timers
    name  (n) = "<invalid - undefined - overloaded>"
    if (s_loglev > 0) write(s_logunit,F00) 'ERROR: exceeded maximum number of timers'

  end subroutine shr_timer_get

  !===============================================================================

  subroutine shr_timer_start(n)

    !----- arguments -----
    integer(SHR_KIND_IN), intent(in) :: n      ! timer number

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_start) ',a,i5)"

    !-----------------------------------------------------------------------
    !  This routine starts a given timer.
    !-----------------------------------------------------------------------

    if ( n>0 .and. n<=max_timers) then
       if (status(n) == stat_started) call shr_timer_stop(n)

       status(n) = stat_started
       call system_clock(count=cycles1(n))
    else
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
    end if

  end subroutine shr_timer_start

  !===============================================================================

  subroutine shr_timer_stop(n)

    !----- arguments -----
    integer(SHR_KIND_IN), intent(in) :: n  ! timer number

    !----- local -----

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_stop) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  This routine stops a given timer, checks for cycle wrapping, computes the
    !  elapsed time, and accumulates the elapsed time in the dt(n) array
    !-------------------------------------------------------------------------------

    if ( n>0 .and. n<=max_timers) then
       if ( status(n) == stat_started) then
          call system_clock(count=cycles2(n))
          if (cycles2(n) >= cycles1(n)) then
             dt(n) = dt(n) + clock_rate*(cycles2(n) - cycles1(n))
          else
             dt(n) = dt(n) + clock_rate*(cycles_max + cycles2(n) - cycles1(n))
          endif
          calls (n) = calls(n) + 1
          status(n) = stat_stopped
       end if
    else
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
    end if

  end subroutine shr_timer_stop

  !===============================================================================

  subroutine shr_timer_print(n)

    !----- arguments -----
    integer(SHR_KIND_IN), intent(in) :: n     ! timer number

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_print) ',a,i5)"
    character(len=*),parameter :: F01 = "('(shr_timer_print) timer',i3,&
         &                                     ':',i8,' calls,',f10.3,'s, id: ',a)"
    !-------------------------------------------------------------------------------
    !  prints the accumulated time for a given timer
    !-------------------------------------------------------------------------------

    if ( n>0 .and. n<=max_timers) then
       if (status(n) == stat_started) then
          call shr_timer_stop(n)
          if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n))
          call shr_timer_start(n)
       else
          if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n))
       endif
    else
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
    end if

  end subroutine shr_timer_print

  !===============================================================================

  subroutine shr_timer_print_all

    !----- local -----
    integer(SHR_KIND_IN) :: n

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_print_all) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  prints accumulated time for all timers in use
    !-------------------------------------------------------------------------------

    if (s_loglev > 0) write(s_logunit,F00) 'print all timing info:'

    do n=1,max_timers
       if (status(n) /= stat_free) call shr_timer_print(n)
    end do

  end subroutine shr_timer_print_all

  !===============================================================================

  subroutine shr_timer_zero(n)

    !----- arguments -----
    integer(SHR_KIND_IN), intent(in) :: n       ! timer number

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_zero) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  This routine resets a given timer.
    !-------------------------------------------------------------------------------

    if ( n>0 .and. n<=max_timers) then
       dt(n) = 0.0_SHR_KIND_R8
       calls(n) = 0
    else
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
    end if

  end subroutine shr_timer_zero

  !===============================================================================

  subroutine shr_timer_zero_all

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_zero_all) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  This routine resets all timers.
    !-------------------------------------------------------------------------------

    dt = 0.0_SHR_KIND_R8
    calls = 0

  end subroutine shr_timer_zero_all

  !===============================================================================

  subroutine shr_timer_check(n)

    !----- arguments -----
    integer(SHR_KIND_IN), intent(in) ::  n   ! timer number

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_check) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  This routine checks a given timer.  This is primarily used to
    !  periodically accumulate time in the timer to prevent timer cycles
    !  from wrapping around max_cycles.
    !-------------------------------------------------------------------------------

    if ( n>0 .and. n<=max_timers) then
       if (status(n) == stat_started) then
          call shr_timer_stop (n)
          call shr_timer_start(n)
       endif
    else
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
    end if

  end subroutine shr_timer_check

  !===============================================================================

  subroutine shr_timer_check_all

    !----- local -----
    integer(SHR_KIND_IN) :: n

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_check_all) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  Call shr_timer_check for all timers in use
    !-------------------------------------------------------------------------------

    do n=1,max_timers
       if (status(n) == stat_started) then
          call shr_timer_stop (n)
          call shr_timer_start(n)
       endif
    end do

  end subroutine shr_timer_check_all

  !===============================================================================

  subroutine shr_timer_free(n)

    !----- arguments -----
    integer(SHR_KIND_IN),intent(in) :: n    ! timer number

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_free) ',a,i5)"

    !-----------------------------------------------------------------------
    !  initialize/free all timer array values
    !-----------------------------------------------------------------------

    if ( n>0 .and. n<=max_timers) then
       status (n) = stat_free
       name   (n) = "<invalid - undefined>"
       dt     (n) = 0.0_SHR_KIND_R8
       cycles1(n) = 0
       cycles2(n) = 0
    else
       if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
    end if

  end subroutine shr_timer_free

  !===============================================================================

  subroutine shr_timer_free_all

    !----- local -----
    integer(SHR_KIND_IN) :: n

    !----- i/o formats -----
    character(len=*),parameter :: F00 = "('(shr_timer_free_all) ',a,i5)"

    !-------------------------------------------------------------------------------
    !  initialize/free all timer array values
    !-------------------------------------------------------------------------------

    do n=1,max_timers
       call shr_timer_free(n)
    end do

  end subroutine shr_timer_free_all

  !===============================================================================

  subroutine shr_timer_sleep(sec)

    use shr_sys_mod     ! share system calls (namely, shr_sys_sleep)

    !----- local -----
    real   (SHR_KIND_R8),intent(in) :: sec  ! number of seconds to sleep

    !-------------------------------------------------------------------------------
    ! Sleep for approximately sec seconds
    !
    ! Note: sleep is typically a system call, hence it is implemented in
    !       shr_sys_mod, although it probably would only be used in a timing
    !       context, which is why there is a shr_timer_* wrapper provided here.
    !-------------------------------------------------------------------------------

    call shr_sys_sleep(sec)

  end subroutine shr_timer_sleep

  !===============================================================================
end module shr_timer_mod
!===============================================================================
